home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / TEXT2DBF.ZIP;1 / TEXT2DBF.PRG < prev   
Encoding:
Text File  |  1992-09-15  |  11.8 KB  |  307 lines
  1. *****************************************************************************
  2. *** Program : TEXT2DBF  Copyright (c) BITwise Computer Services, 1992     ***
  3. *** Date    : 08/31/92                                                    ***
  4. *** Author  : David W. Christian                                          ***
  5. *** Purpose : General purpose Text file to .DBF file conversion program   ***
  6. *** Notes   : compile with /n /w                                          ***
  7. *****************************************************************************
  8. *** REVISIONS:                                                            ***
  9. ***                                                                       ***
  10. *****************************************************************************
  11.  
  12.  
  13. #include "basic.ch"
  14. #include "fileio.ch"
  15. #define LINEBUFF  1024
  16. #define CRLF      CHR(13)+CHR(10)
  17.  
  18.  
  19. STATIC lEof:=.F.
  20.  
  21. FUNCTION TEXT2DBF(cSource,cDest,cCDF)
  22.    LOCAL aDestStruc:={}, nX:=0, nSource:=0, nDest:=0, aStruc:={}, ;
  23.       nRow:=0, nCol:=0, cFldList:="", cField:="", cType:="", nLen:=0, ;
  24.       nDec:=0, bBlock, nRet:=0
  25.    MEMVAR  cExp, cRec, nCnt
  26.    PRIVATE cExp:="", cRec:="", nCnt:=0
  27.  
  28.    ? "TEXT2DBF 1.0 Copyright (C) BITwise Computer Services, 1992."
  29.    // CHECK SYNTAX
  30.    IF cSource<>NIL .AND. cDest<>NIL .AND. cCDF<>NIL
  31.       IF FILE(cSource)
  32.  
  33.          // READ FORMAT FILE AND LOAD DESTINATION STRUCTURE ARRAY
  34.          cCDF+=IIF(AT(".",cCDF)>0,"",".CDF")  // ADD DEFAULT EXTENSION
  35.          IF FILE(cCDF)
  36.             IF ( nSource:=FOPEN(cCDF,FO_READ) ) <>-1
  37.                lEof:=.F.
  38.                nCnt:=0
  39.                ? "Processing CDF..."
  40.                DO WHILE nRet==0 .AND. !lEof
  41.                   nCnt++
  42.                   cRec:=UPPER(P_READLN(nSource,LINEBUFF))   // READ A LINE
  43.                   IF !EMPTY(cRec) .AND. !LTRIM(cRec)="*"
  44.                      // PARSE ARRAY COMPONENTS
  45.                      cField:=P_PARSE(@cRec)
  46.                      cType :=P_PARSE(@cRec)
  47.                      nLen  :=ABS(VAL(P_PARSE(@cRec)))
  48.                      nDec  :=ABS(VAL(P_PARSE(@cRec)))
  49.                      cExp:=P_PARSE(@cRec)
  50.  
  51.                      // CHECK FOR ERRORS IN FIELD DEFINITION
  52.                      nRet:=-1
  53.                      DO CASE
  54.                      CASE cField$cFldList
  55.                         P_ERRORMSG("ERROR Duplicate field name "+cField+" - "+cCDF+" line "+STR(nCnt,3))
  56.                      CASE P_BADFIELD(cField)
  57.                         P_ERRORMSG("ERROR Illegal field name "+cField+" - "+cCDF+" line "+STR(nCnt,3))
  58.                      CASE LEN(cType)<>1 .OR. !cType$"CNDLM"
  59.                         P_ERRORMSG("ERROR Invalid field type - "+cCDF+" line "+STR(nCnt,3))
  60.                      CASE ( nLen==0 ) .OR. ;
  61.                           ( cType=="C" .AND. nLen>65536 ) .OR. ;
  62.                           ( cType=="N" .AND. nLen>30 ) .OR. ;
  63.                           ( cType=="D" .AND. nLen<>8 ) .OR. ;
  64.                           ( cType=="L" .AND. nLen<>1 ) .OR. ;
  65.                           ( cType=="M" .AND. nLen<>10 )
  66.                         P_ERRORMSG("ERROR Invalid field length - "+cCDF+" line "+STR(nCnt,3))
  67.                      CASE ( cType<>"N" .AND. nDec<>0 ) .OR. nDec>16
  68.                         P_ERRORMSG("ERROR Invalid field decimals length - "+cCDF+" line "+STR(nCnt,3))
  69.                      CASE !TYPE(cExp)$"C~N~D~L~M~UI"
  70.                         P_ERRORMSG("ERROR Invalid expression - "+cCDF+" line "+STR(nCnt,3))
  71.                      CASE P_BADTYPES(TYPE(cExp),cType)
  72.                         P_ERRORMSG("ERROR Type mismatch between field and expression - "+cCDF+" line "+STR(nCnt,3))
  73.                      OTHERWISE
  74.                         nRet:=0    // NO ERRORS
  75.                      ENDCASE
  76.  
  77.                      // ADD ELEMENT TO ARRAY
  78.                      IF nRet==0
  79.                         bBlock:= &("{|cRec| "+cExp+"}")
  80.                         AADD(aDestStruc,{cField,cType,nLen,nDec,bBlock})
  81.                         cFldList+=cField  // ADD FIELD NAME TO LIST
  82.                      END
  83.                   END
  84.                END
  85.                
  86.                IF nRet<>-1
  87.                   // SEE IF DESTINATION FILE OK
  88.                   lEof:=.F.
  89.                   IF FILE(cDest)
  90.                      // DESINATION FILE EXISTS - CHECK STRUCTURE AGAINST ARRAY
  91.                      USE (cDest) ALIAS DEST NEW
  92.                      aStruc:=DBSTRUCT()
  93.                      IF LEN(aStruc)==LEN(aDestStruc)
  94.                         FOR nX:=1 TO LEN(aStruc)
  95.                            IF !aStruc[nX][1]==aDestStruc[nX][1] .OR. ;
  96.                               !aStruc[nX][2]==aDestStruc[nX][2] .OR. ;
  97.                               !aStruc[nX][3]==aDestStruc[nX][3] .OR. ;
  98.                               !aStruc[nX][4]==aDestStruc[nX][4]
  99.                               EXIT
  100.                            END
  101.                         NEXT
  102.                         lEof:=( nX>LEN(aStruc) )
  103.                      END
  104.                   ELSE    // CREATE DESTINATION FILE
  105.                      ? "Creating "+cDest+"..."
  106.                      DBCREATE(cDest,aDestStruc)
  107.                      USE (cDest) ALIAS DEST NEW
  108.                      lEof:=.T.
  109.                   END
  110.  
  111.                   IF lEof
  112.                      // DESTINATION FILE OPEN - OPEN SOURCE FILE
  113.                      FCLOSE(nSource)
  114.                      IF ( nSource:=FOPEN(cSource,FO_READ) ) <>-1
  115.  
  116.                         // OK, NOW FOR THE FUN PART - READ EACH RECORD IN
  117.                         // SOURCE FILE AND PLACE THE RESULTS OF EACH FIELD
  118.                         // CODEBLOCK INTO THE CORRESPONDING DEST FIELD
  119.                         ? "Adding Records: "
  120.                         nRow:=ROW(); nCol:=COL()
  121.                         lEof:=.F.
  122.                         nCnt:=0
  123.                         DO WHILE !lEof .AND. INKEY()<>K_ESC
  124.                            cRec:=P_READLN(nSource,LINEBUFF)   // READ A LINE
  125.                            IF !lEof
  126.                               @ nRow,nCol SAY ++nCnt
  127.                               DBAPPEND()
  128.                               FOR nX:=1 TO LEN(aDestStruc)
  129.                                  FIELDPUT(nX,EVAL(aDestStruc[nX][5],cRec))
  130.                               NEXT
  131.                            END
  132.  
  133.                         END
  134.                         IF LASTKEY()<>K_ESC
  135.                            ? "All done!"
  136.                         ELSE
  137.                            ? "User abort"
  138.                         END
  139.                      ELSE
  140.                         P_ERRORMSG('error opening "'+cSource+'"')
  141.                      END
  142.                   ELSE
  143.                      P_ERRORMSG('structure of "'+cDest+'" does not match CDF')
  144.                   END
  145.                   CLOSE dest
  146.                END
  147.                FCLOSE(nSource)
  148.             ELSE
  149.                P_ERRORMSG('error opening "'+cCDF+'"')
  150.             END
  151.          ELSE
  152.             P_ERRORMSG('CDF file "'+cCDF+'" not found')
  153.          END
  154.       ELSE
  155.          P_ERRORMSG('Source file "'+cSource+'" not found')
  156.       END
  157.    ELSE
  158.       ? CHR(7)
  159.       ? "Syntax: TEXT2DBF source dest convert[.CDF]"
  160.       ? "  source     source file in System Data Format - Ascii file,"
  161.       ? "             fixed field positions, records end with CRLF"
  162.       ?
  163.       ? "  dest       destination dBase III+ compatible file - .DBF extension"
  164.       ? "             assumed if not supplied, file will be created from"
  165.       ? "             CDF file if not found, otherwise records will be"
  166.       ? "             appended into existing file"
  167.       ?
  168.       ? "  convert    Conversion Definition file (CDF) - defines field "
  169.       ? "             structures of destination file and conversion expressions"
  170.       ? "             to retrieve and manipulate source data"
  171.       ?
  172.       ? "BITwise Computer Services"
  173.       ? "PO Box 97642"
  174.       ? "Raleigh, NC 27624-7642"
  175.       ? "(919) 676-9727"
  176.    ENDIF
  177.    ?
  178. RETURN(NIL)
  179.  
  180.  
  181. FUNCTION P_ERRORMSG(cMsg)
  182.    // SYNTAX: P_ERRORMSG(<expC1>)
  183.    //         - BEEPS AND DISPLAYS ERROR MESSAGE cMsg
  184.    ? CHR(7)+cMsg
  185. RETURN(NIL)
  186.  
  187.  
  188. FUNCTION P_BADFIELD(cField)
  189.    // SYNTAX: P_BADFIELD(<expC1>)
  190.    //         - VALIDATES FIELD NAME cField AND RETURNS .T. IF BAD
  191.    //
  192.    LOCAL lRet:=.F., nPos:=1
  193.    lRet:=( LEN(cField)>10 )
  194.    WHILE !lRet .AND. nPos<=LEN(cField)
  195.       lRet:=!( SUBSTR(cField,nPos,1)$"ABCDEFGHIJKLMNOPQRSTUVWXYZ"+;
  196.          IIF(nPos<>1,"0123456789_","") )
  197.       nPos++
  198.    END
  199. RETURN(lRet)
  200.  
  201.  
  202. FUNCTION P_BADTYPES(cExpType,cFldType)
  203.    // SYNTAX: P_BADTYPES(<expC1>,<expC2>)
  204.    //         - COMPARES EXPRESSION AND FIELD TYPES
  205.    //         - RETURNS .T. IF INCOMPATIBLE
  206.    //
  207.    LOCAL lRet:=.F.
  208.    DO CASE
  209.    CASE cExpType==cFldType
  210.    CASE cExpType=="UI"
  211.    CASE cExpType=="C" .AND. cFldType=="M"
  212.    OTHERWISE
  213.       lRet:=.T.
  214.    ENDCASE
  215. RETURN(lRet)
  216.  
  217.  
  218. FUNCTION P_READLN(nHandle,nBuffSize)
  219.    // SYNTAX: <expC1>:=P_READLN(<expN1>,[<expN2>])
  220.    //         - RETURNS LINE OF TEXT FROM FILE nHandle
  221.    //         - USES A READAHEAD LINE BUFFER OF SIZE nBuffSize FOR SPEED
  222.    //            (RECORD LENGTH INCLUDING CRLF MUST NOT EXCEED nBuffSize!)
  223.    //         - LINE IS ASSUMED TERMINATED WITH CR/LF PAIR
  224.    //         - MOVES POINTER TO START OF NEXT LINE (OR EOF)
  225.    //
  226.    LOCAL cRet:="", cBuff:="", nPos:=0, nEol:=0, nRead:=0
  227.    DEFAULT nBuffSize TO 1024
  228.    cBuff:=SPACE(nBuffSize)
  229.    nPos:=FSEEK(nHandle,0,FS_RELATIVE)    // SAVE CURRENT POSITION
  230.    IF ( nRead:=FREAD(nHandle,@cBuff,nBuffSize) ) > 0
  231.       IF ( nEol:=AT(CRLF,SUBSTR(cBuff,1,nRead)) ) == 0
  232.          cRet:=cBuff       // LINE OVERFLOW OR EOF() - RETURN ENTIRE BUFFER
  233.       ELSE
  234.          cRet:=SUBSTR(cBuff,1,nEol-1)
  235.          FSEEK(nHandle,nPos+nEol+1,FS_SET)
  236.       END
  237.    ELSE
  238.       lEof:=.T.
  239.    END
  240. RETURN(cRet)
  241.  
  242.  
  243. FUNCTION P_PARSE(cStr,cDelim,lTrim)
  244.    // SYNTAX: <expC1>:=P_PARSE(@<expC2>,[<expC3>],[<expL1>])
  245.    //         - PARSES LINE cStr AND RETURNS NEXT CHUNK DELIMITED BY cDelim
  246.    //         - PARSED TEXT IS RETURNED AND REMOVED FROM cStr (PASSED BY REF)
  247.    //         - PARSED TEXT IS ALLTRIM()'ed IF lTrim
  248.    //         - NOTE: DELIMITER IS NOT INCLUDED IN RETURN STRING
  249.    //                 DELIMITER NOT REQUIRED AT END OF cStr
  250.    LOCAL cRet:=cStr, nPos:=0
  251.    DEFAULT cDelim TO "|", lTrim TO .T.
  252.    nPos:=AT(cDelim,cStr)
  253.    IF nPos>0
  254.       cRet:=LEFT(cStr,nPos-1)
  255.       cStr:=SUBSTR(cStr,nPos+LEN(cDelim))
  256.    ELSE
  257.       cStr:=""    // ENTIRE LINE PARSED
  258.    ENDIF
  259. RETURN(IIF(lTrim,ALLTRIM(cRet),cRet))
  260.  
  261.  
  262.  
  263.   ////////////////////////////
  264.  /// CONVERSION FUNCTIONS ///
  265. ////////////////////////////
  266.  
  267.  
  268. FUNCTION VALIMPDEC(cNum,nDecimals)
  269.    // SYNTAX: <expN1>:=VALIMPDEC(<expC1>,[<expN2>])
  270.    //         - CONVERTS IMPLIED-DECIMAL STRING cNum TO CLIPPER NUMERIC
  271.    //         - nDecimals IS NUMBER OF DECIMAL POSITIONS (DEFAULT 2)
  272.    //
  273.    DEFAULT nDecimals TO 2
  274. RETURN( VAL( STUFF(cNum,LEN(cNum)-(nDecimals-1),0,".") ) )
  275.  
  276.  
  277. FUNCTION CDATE2DT(cDate,cFormat)
  278.    // SYNTAX: <expD1>:=CDATE2DT(<expC1>,[<expC2>])
  279.    //         - CONVERTS DATE STRING cDate TO CLIPPER DATE
  280.    //         - cFormat IS DATE STRING FORMAT (DEFAULT "M2D2Y2")
  281.    //         - RETURNS EMPTY() DATE IF INVALID FORMAT OR STRING
  282.    //         - SAMPLE FORMATS:
  283.    //            "M2D2Y2"  =>  "122592"   MMDDYY
  284.    //            "M2D2Y4"  =>  "12251992" MMDDYYYY
  285.    //            "D2M2Y2"  =>  "251292"   DDMMYY
  286.    //
  287.    LOCAL cMM:="", cDD:="", cYY:="", nX:=0, cType:="", nLen:=0, nPos:=1
  288.    DEFAULT cFormat TO "M2D2Y2"
  289.    cFormat:=UPPER(cFormat)
  290.    FOR nX:=1 TO 6 STEP 2
  291.       cType:=SUBSTR(cFormat,nX,1)
  292.       nLen:=VAL(SUBSTR(cFormat,nX+1,1))
  293.       DO CASE
  294.       CASE cType=="M"
  295.          cMM:=SUBSTR(cDate,nPos,nLen)
  296.       CASE cType=="D"
  297.          cDD:=SUBSTR(cDate,nPos,nLen)
  298.       CASE cType=="Y"
  299.          cYY:=SUBSTR(cDate,nPos,nLen)
  300.       ENDCASE
  301.       nPos+=nLen
  302.    NEXT
  303. RETURN(CTOD(cMM+"/"+cDD+"/"+cYY))
  304.  
  305.  
  306. //EOF
  307.